home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
BBS_UTL
/
BOI200P
/
ASYNC.PAS
next >
Wrap
Pascal/Delphi Source File
|
1992-12-13
|
13KB
|
395 lines
{ $D-} { Debug Information Off }
{ $S-} { Stack Checking Off }
{$V-} { String Checking Off }
{$F+}
Unit Async;
{ Part of BBS Onliner Interface }
{ Copyright (C) 1990, 1992 Andrew J. Mead
All Rights Reserved. }
{ original version 9/5/90
history found in IOLIB.PAS
4/ 7/91 DropCarrier modified (dolocal condition added)
4/16/91 CallOldInt added
For more information regarding FOSSIL function calls, you can obtain
PASFOSS1.ZIP from me. It is a FreeWare Pascal source API of FOSSIL
revision 5 calls.
}
INTERFACE
Function CARRIER : boolean; { Carrier Detect function }
Procedure DROPCARRIER; { Drop Carrier }
Procedure ASYNCINT; Interrupt; { won't work if not in interface??? }
Procedure SENDCHAR(outchar : char); { Comport Output Routine }
Function CHARREADY : boolean; { Character Ready for Input }
Function READBUFFER : char; { Get Character from buffer }
Procedure CLEARINBUFFER; { Empty input buffer }
Procedure SETBUFFERSIZE(newsize : integer); { Set buffer size, defaul = 1k }
Function INTINIT : byte; { Install Comport Interrupt }
IMPLEMENTATION
Uses
boidecl,
iolib,
dos;
Const
null = #0;
icom_maxbuff = 1024; { circular input buffer maximum size }
{ UART - Universal Asynchronious Receiver/Transmitter }
THRoff = $00; { 8250 UART Transmitter Holding Register offset }
RBRoff = $00; { 8250 UART Receiver Buffer Register offset }
DLLoff = $00; { 8250 UART Divisor Latch Least Significant Byte offset }
DLMoff = $01; { 8250 UART Divisor Latch Most Significant Byte offset }
IERoff = $01; { 8250 UART Interrupt Enable Register offset }
IIRoff = $02; { 8250 UART Interrupt Identification Register offset }
LCRoff = $03; { 8250 UART Line Control Register offset }
MCRoff = $04; { 8250 UART Modem Control Register offset }
LSRoff = $05; { 8250 UART Line Status Register offset }
MSRoff = $06; { 8250 UART Modem Status Register offset }
{ IRQ0..7 }
PICCMD = $20; { 8259A Programmable Interrupt Controller Port (Command) }
PICMSK = $21; { 8259A Programmable Interrupt Controller Port (Mask) }
{ IRQ8..15 }
PIC2CMD = $A0; { cascade 8259A PIC (Command) }
PIC2MSK = $A1; { cascade 8259A PIC (Mask) }
RTSbit = $20; { Ready To Send bit in LSR }
CTSbit = $10; { Clear To Send bit in MSR }
DCDbit = $80; { Data Carrier Detect (RLSD) bit in MSR }
DCval = $08; { changes carrier detect bit in MSR }
fossint = $14;
Type
portbufftype = array [1..icom_maxbuff] of char;
Var
icom_portbuffer : portbufftype; { Circular input buffer }
icom_bufflimit : integer; { Current maximum buffer size }
icom_buffsize : integer; { Number of character in buffer }
icom_buffend : integer; { Index pointing to last char in buffer }
icom_buffstart : integer; { Index pointing to first char in buffer }
icom_asyncvector : pointer; { original interrupt vector }
IIRstatus : byte; { 8250 UART IIR status byte }
LSRstatus : byte; { 8250 UART LCR status byte }
foss_regs : registers;
Procedure CALLOLDINT(sub : pointer);
begin {* CallOldInt *}
Inline($9C/ { PushF }
$FF/$5E/$06) { Call DWord PTR [BP + 6] }
end; {* CallOldInt *}
Function CARRIER : boolean;
var
ctemp : boolean;
{ This function will return 'true' if
a) program is in 'local' mode
b) carrier detect is disabled (command line option)
c) carrier (phone line) is detected. }
begin {* fCarrier *}
if boi_local or (not boi_checkcd) then Carrier := true
else
begin
case boi_cmode of
com_internal :
ctemp := ((port[boi_portadd + MSRoff] and DCDbit) = DCDbit);
com_fossil :
begin
foss_regs.AH := $03;
foss_regs.DX := boi_portnum;
Intr(fossint,foss_regs);
ctemp := foss_regs.AL and $80 = $80
end
end;
if not ctemp then boi_cdlost := true;
Carrier := ctemp
end
end; {* fCarrier *}
Procedure DROPCARRIER;
{ This function will force the modem to hang up the phone.}
const
DTRlow = $00; { force DTR low value }
var
timebase : longint;
begin {* DropCarrier *}
if not boi_local then
begin
boi_cdlost := true;
case boi_cmode of
com_internal :
begin
timebase := boi_timer;
repeat port[boi_portadd + MCRoff] := DTRlow
until boi_timer >= timebase + 36 { force DTR low for 2 seconds }
end;
com_fossil :
begin
foss_regs.AH := $06;
foss_regs.AL := DTRlow;
foss_regs.DX := boi_portnum;
Intr(fossint,foss_regs)
end
end
end
end; {* DropCarrier *}
Procedure ASYNCINT;
begin {* AsyncInt *}
Inline($FB); { STI }
if boi_tintr then BOI_Crit;
IIRstatus := port[boi_portadd + IIRoff]; { read IIR status }
if ((IIRstatus and $06) = $04) then { check to see if character waiting }
begin { place character in buffer }
if icom_buffsize < icom_bufflimit then
begin
icom_portbuffer[icom_buffend] := Chr(Port[boi_portadd + RBRoff]);
if icom_buffend < icom_bufflimit then
Inc(icom_buffend)
else icom_buffend := 1;
Inc(icom_buffsize)
end
else LSRstatus := Port[boi_portadd + RBRoff] { clear LSR status byte }
end
{ else CallOldInt(asyncvector); } { call previous interrupt for processing }
else if ((IIRstatus and $06) = $06) then
LSRstatus := Port[boi_portadd + RBRoff];
if boi_tintr then BOI_Safe;
Inline($FA); { CLI }
Port[PICCMD] := $20; { reset 8259A PIC }
if boi_cascade then Port[PIC2CMD] := $20 { reset cascade 8259A PIC }
end; {* AsyncInt *}
Procedure SENDCHAR(outchar : char);
var
charsent : boolean;
begin {* SendChar *}
boi_stall := 1;
case boi_cmode of
com_internal :
begin
while (port[boi_portadd + LSRoff] and
RTSbit <> RTSbit) or { <- UART ready }
({ baudlock and } { /B switch is now assumed }
(port[boi_portadd + MSRoff] and CTSbit <> CTSbit)) do
begin { ^^ modem ready ^^ }
if not in_dos^ then BOI_Wait;
if not Carrier then DoTimeOut(false)
else if boi_stall >= 1092 then DoTimeOut(false)
{ timeout after 60 seconds, assume carrier is lost }
end;
port[boi_portadd + RBRoff] := Ord(outchar) { send character }
end;
com_fossil :
begin
repeat
begin
foss_regs.AH := $0B;
foss_regs.AL := Ord(outchar);
foss_regs.DX := boi_portnum;
Intr(fossint,foss_regs);
charsent := foss_regs.AX = $0001;
if not charsent then
begin
if (not Carrier) or (boi_stall > 1092) then
DoTimeOut(false);
if not in_dos^ then BOI_Wait
end
end
until charsent
end
end
end; {* SendChar *}
Function CHARREADY : boolean;
begin {* fCharReady *}
case boi_cmode of
com_internal : CharReady := icom_buffsize > 0;
com_fossil :
begin
foss_regs.AH := $03;
foss_regs.DX := boi_portnum;
Intr(fossint,foss_regs);
CharReady := foss_regs.AH and $01 = $01
end
end
end; {* fCharReady *}
Function READBUFFER : char;
var
rb : char;
begin {* fReadBuffer *}
if CharReady then case boi_cmode of
com_internal :
begin
rb := icom_portbuffer[icom_buffstart];
if icom_buffstart < icom_bufflimit then
Inc(icom_buffstart) else icom_buffstart := 1;
Dec(icom_buffsize);
ReadBuffer := rb
end;
com_fossil :
begin
foss_regs.AH := $02;
foss_regs.DX := boi_portnum;
Intr(fossint,foss_regs);
ReadBuffer := Chr(foss_regs.AL)
end
end
else ReadBuffer := null
end; {* fReadBuffer *}
Procedure CLEARINBUFFER;
begin {* ClearInBuffer *}
case boi_cmode of
com_internal :
begin
icom_buffend := icom_buffstart;
icom_buffsize := 0
end;
com_fossil :
begin
foss_regs.AH := $0A;
foss_regs.DX := boi_portnum;
Intr(fossint,foss_regs)
end
end
end; {* ClearInBuffer *}
Procedure SETBUFFERSIZE(newsize : integer);
begin {* SetBufferSize *}
if (newsize > 1) and (newsize <= icom_maxbuff) then
begin
icom_buffstart := 1;
ClearInBuffer;
icom_bufflimit := newsize
end;
end; {* SetBufferSize *}
var
intexit : pointer;
Procedure ASYNCEND;
begin {* AsyncEnd *}
exitproc := intexit;
Inline($FA); { CLI }
{} boi_portstatus := false;
SetIntVec(boi_portint,icom_asyncvector); { re-install old interrupt vector }
Port[PICCMD] := $20; { reset 8259A PIC }
if boi_cascade then Port[PIC2CMD] := $20; { reset cascade 8259A PIC }
Inline($FB) { STI }
end; {* AsyncEnd *}
Procedure FOSSILEND;
begin {* FOSSILEnd *}
exitproc := intexit;
foss_regs.AH := $05;
foss_regs.DX := boi_portnum;
Intr(fossint,foss_regs)
end; {* FOSSILEnd *}
Function INTINIT : byte;
var
initerr : byte;
Procedure ASYNCINIT;
var
inittemp : byte; { temporary data holding variable }
begin {* fIntInit,AsyncInit *}
intexit := exitproc;
exitproc := @AsyncEnd;
FillChar(icom_portbuffer,SizeOf(icom_portbuffer),32);
icom_buffend := 1;
icom_buffstart := 1;
icom_buffsize := 0;
icom_bufflimit := icom_maxbuff;
{} boi_portstatus := true;
GetIntVec(boi_portint,icom_asyncvector); { save old interrupt vector }
SetIntVec(boi_portint,@AsyncInt); { install AsyncInt vector }
boi_cmode := com_internal;
boi_cstr := ' Internal Comm Active';
Port[PICMSK] := Port[PICMSK] and boi_picmask; { access 8259A PIC }
if boi_cascade then
Port[PIC2MSK] := Port[PIC2MSK] and boi_pic2msk;
Port[boi_portadd + LCRoff] := Port[boi_portadd + LCRoff] and $7F;
{ disable divisor latch register }
Port[boi_portadd + IERoff] := $01; { enable interrupts }
Port[boi_portadd + MCRoff] := $0B; { set RTS, DTR and OUT2 }
{ Port[boi_portadd + MSRoff] := $80; } {}
inittemp := Port[boi_portadd + LSRoff]; { reset LSR }
Port[PICCMD] := $20; { reset 8259A PIC }
if boi_cascade then Port[PIC2CMD] := $20 { reset cascade 8259A PIC }
end; {* fIntInit,AsyncInit *}
Procedure FOSSILINIT;
type
charray = array [1..80] of char;
inforec = record
stuff : longint;
idstr : ^charray
end;
var
fossbuff : ^inforec;
begin {* FOSSILInit *}
if foss_init AND $04 = $04 then
begin
intexit := exitproc;
exitproc := @FOSSILEnd
end;
boi_cmode := com_fossil;
ClearInBuffer;
New(fossbuff);
foss_regs.AH := $1B;
foss_regs.CX := 8;
foss_regs.DX := boi_portnum;
foss_regs.ES := ptrmask(fossbuff).pseg;
foss_regs.DI := ptrmask(fossbuff).poff;
Intr(fossint,foss_regs);
Move(fossbuff^.idstr^,boi_cstr[2],78);
boi_cstr[0] := #80;
boi_cstr[1] := ' ';
boi_cstr[0] := Chr(Pos(#00,boi_cstr) - 1);
Dispose(fossbuff)
end; {* FOSSILInit *}
begin {* fIntInit *}
initerr := 0;
if foss_init AND $01 = $01 then AsyncInit
else
begin
foss_regs.AH := $04;
foss_regs.DX := boi_portnum;
Intr(fossint,foss_regs);
{ fossrev := regs.bh; { FOSSIL version implemented }
{ fossfunc := regs.bl { highest FOSSIL function supported }
if foss_regs.AX = $1954 then FOSSILInit
else if foss_init AND $02 <> $02 then AsyncInit
else initerr := 31
end;
IntInit := initerr
end; {* fIntInit *}
begin {* uAsync *}
end. {* uAsync *}